home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1998 August: Tool Chest / Dev.CD Aug 98 TC.toast / Tool Chest / Testing & Debugging / Mac OS Development Toolkit / Automation Essentials 2.3.0 / Host Automation Folder / SPEC Libs / TCS.Lib < prev    next >
Encoding:
Text File  |  1998-03-19  |  55.0 KB  |  1,377 lines  |  [TEXT/MPS ]
  1. #
  2. # ****************************************************************************
  3. #
  4. #    File Name:    TCS.Lib
  5. #
  6. #    Contains:    Library used for tracking and logging Test Case completion and success/failure.
  7. #
  8. #    Written by:    KTA, KL, ML, GS et al
  9. #
  10. #    Copyright:    © 1993-1996 by Apple Computer, Inc., all rights reserved.
  11. #
  12. # ****************************************************************************
  13. #            C h a n g e        H i s t o r y (most recent first):
  14. # ****************************************************************************
  15. #
  16. #        Vers      Date        Author        Description
  17. #        ----    --------    ------    ---------------------------------------------
  18. #    .111111>     6/18/96    MDF        Added support to SuiteEnd() for tracking the number of failed
  19. #                                    test cases.
  20. #    .111110>     6/18/96    MDF        Added global gIsBothMethods to correctly         handle both
  21. #                                    test case logging methods.
  22. #    .11119+>     6/18/96    MDF        Added global gIsBothMethods to correctly handle both test case
  23. #                                    logging methods.
  24. #    2.11119>     6/17/96    MDF        Modified SuiteEnd() to check for single digit         day.
  25. #    .11118+>     6/17/96    MDF        Modified SuiteEnd() to check for single digit day.
  26. #    2.11118>     3/11/96    JC        Modified to call BuildSuiteFields regardless         if Results
  27. #                                    Express global to set to false         and if TRACS global is
  28. #                                    set to true.
  29. #    .11117+>     3/11/96    JC        Modified to call BuildSuiteFields regardless if Results Express
  30. #                                    global to set to false and if TRACS global is set to true.
  31. #    2.11117>     2/23/96    JC        Add TRACS support.
  32. #    .11116+>     2/23/96    JC        Add TRACS support.
  33. #    2.11116>      1/2/96    ML        InitTCSLogging - add TCS ID constant for         printing.
  34. #    .11115+>      1/2/96    ML        InitTCSLogging - add TCS ID constant for printing.
  35. #    2.11115>    11/13/95    ML        InitTCSlogging() - Move initializing kTCSNoLoggingMethod and
  36. #                                    kTCSResultsExpressMethod to InitGlobals()
  37. #    .11114+>    11/13/95    ML        InitTCSlogging() -
  38. #    2.11114>     4/14/95    KTA        SuiteStart() - auto call InitGlobals() if not already
  39. #                                    initialized.
  40. #    2.11113>     4/11/95    KTA        Created a task isSystem7() which we now call instead of 
  41. #                                    determining this directly.
  42. #    2.11112>     3/23/95    ML        SetUpOutput() - Temporarily set CommandExceptions off when
  43. #                                    calling InitResultsExpress() so we don't throw if it fails
  44. #    2.11111>      3/8/95    ML        InitTCSLogging() - removed gDialoghandling
  45. #    2.11110>     2/28/95    ML        marked
  46. #    2.1119>         2/28/95        KTA        Added Marks, TCSEnd() - Don't check for unexpected dialogs if
  47. #                                    pBailFlag set.
  48. #    2.1118>         2/16/95        ML        TCSEnd() - Set pResultCode to 0 if CheckforSystemFailure() is
  49. #                                    true.  CheckforSystemFailure() - returns boolean
  50. #    .2.1117>     2/13/95    KTA        SuiteStart() - Check to see if pUseXTools is true before calling
  51. #                                    InstallEverytimeMacro.
  52. #    .2.1116>      2/6/95    ML        Revise ExitVU() to throw instead of exit
  53. #    .2.1114>     1/31/95    KTA        SuiteStart() - added call to InstallEverytimeMacro() if
  54. #                                    gCrashHandling is TRUE.
  55. #    .2.1113>     1/31/95    KTA        Added gTCSEndThreadingHook, gSuiteEndThreadingHook.
  56. #    .2.1112>     1/31/95    KTA        Moved some of the CrashHandling code to the CrashHandling.Lib.
  57. #    .2.1111>     1/19/95    KTA        Changed the name of ExceptionHandler() to ExceptionDispatcher().
  58. #    .2.1110>     1/19/95    KTA        Added some of the CrashHandling stuff.
  59. #    1.2.119>     1/16/95    KTA        Added parameter to SuiteStart(), BuildSuiteFields() to enable
  60. #                                    the ability to not automatically use external tools when filling
  61. #                                    out the suite header.
  62. #    1.2.118>     1/16/95    KTA        Added exceptionHandling to TCS.Lib, also added OSVersion,
  63. #                                    ROMbuild to the suiteHeader.
  64. #    1.2.117>    12/13/94    KTA        Added ExitVU() and declaration of Global gExitVU as a task
  65. #                                    reference.
  66. #    1.2.116>    12/13/94    KTA        Removed Filetool references
  67. #    1.2.114>    12/13/94    KTA        InitTCSLogging() - Added globals gBuildVers, gAppTitle,
  68. #                                    gAppVersion, gMachineName, gIsSys7.
  69. #    1.2.113>     12/7/94    KTA        Changes to support new exceptionHandling for VU 2.1.
  70. #    1.2.112>    11/29/94    ML        Renamed ExceptionDispatcher to TCSExceptionDispatcher to avoid
  71. #                                    conflict with ExceptionDispatcher task in ExceptionHandling.lib
  72. #    1.2.111>     9/22/94    KTA        Added new task - CheckforSystemFailure().
  73. #    1.2.110>     9/21/94    KTA        LogTCSRecord(), BuildTCSFields() - Added support for TCName.
  74. #    <1.2.19>     9/20/94    KTA        SuiteStart(), SuiteEnd(), TCSEnd() - Added global keyword before
  75. #                                    kNullSuiteID.
  76. #    <1.2.18>     9/20/94    KTA        PrintTCSRecord() - Added Print •• if not pResultCode.
  77. #    <1.2.17>     9/19/94    KTA        InitTCSLogging() - Moved globals kNullSuiteID, gCurSuiteID from
  78. #                                    Results Express.Lib. PrintTCSRecord() - added global keyword.
  79. #    <1.2.16>     5/13/94    KTA        ClearStack() - 0 for the top TCS and -1 for all the rest.
  80. #    <1.2.15>     5/11/94    KTA        Removed support for elapsed time field in TCS.
  81. #    <1.2.14>     5/11/94    KTA        TCSEnd() - Call ExceptionDispatcher prior to popping TCS from
  82. #                                    stack, ClearStack() - popping TCSes in wrong order.
  83. #    <1.2.13>      5/3/94    KTA        ExceptionDispatcher() - Added check for -1105 error.
  84. #    <1.2.12>     4/28/94    KTA        SuiteEnd() -if gPrintSuiteInfo print all suiteFooter fields.
  85. #    <1.2.11>     4/27/94    KTA        SuiteEnd() - Changed SuiteVal to Completion
  86. #    <1.2.10>     4/27/94    KTA        Changed AppVers to AppVer
  87. #     <1.2.9>     4/21/94    KTA        Changed RecordMonitorInfo and insure AppVerify doesn't fail when
  88. #                                    gAdditionalTargetinfo.
  89. #     <1.2.8>     4/19/94    KTA        Changed SuiteVers to SuiteVer.
  90. #     <1.2.7>     4/15/94    KTA        TCTrackingOrNot() - Changed way to determine if were going to
  91. #                                    track the TCS.
  92. #     <1.2.6>     4/14/94    KTA        SuiteStart() - Added gSuiteStartHook, SuiteEnd() - Added
  93. #                                    gSuiteEndHook, Changed gTCTracking to filter TCS calls.
  94. #     <1.2.5>     4/13/94    KTA        Changed RecordRAMFootPrint() to RecordGetAboutThisMacintosh().
  95. #     <1.2.4>     4/13/94    KTA        Changed gDBLogging to gTCTracking.
  96. #     <1.2.3>     4/11/94    KTA        InitTCSLogging() - Added a parameter - pCreateFiles.
  97. #     <1.2.2>     4/11/94    KTA        TCSEnd() - Added gLastResortHook().
  98. #     <1.2.1>      4/8/94    ML        add comments to task headers
  99. #     <1.2.0>      4/5/94    KTA        BuildSuiteFields() - Added 'MachineType'.
  100. #    1.1.117>      4/1/94    KTA        SetUpOutput() - println  "Initialized FileTool on the HOST";
  101. #    1.1.116>      4/1/94    KTA        If(ResultsExpress) -  added gPrintSuiteInfo, 'SuiteParams' -
  102. #                                    label was misnamed 'SeedValue', removed 'SystemArch'.
  103. #    1.1.115>     3/31/94    KTA        SuiteEnd()- added a carriage return after gAdditionalSuiteInfoFT
  104. #                                    before writting to suite footer.
  105. #    1.1.114>     3/28/94    KTA        Added <Tool>Operations.Libs.
  106. #    1.1.113>     3/24/94    KTA        TCSEnd()- New DialogHandler.
  107. #    1.1.112>     3/23/94    KTA        LogSuiteHeader() - Added 'MachineType'.
  108. #    1.1.111>     3/23/94    KTA        Added globals gAdditionalTargetInfo, gPrintSuiteInfo.
  109. #    <1.1.20>     3/22/94    KTA        TCSStart() - Turn gDBLogging OFF if SuiteStart() was not called.
  110. #    <1.1.19>     3/22/94    KTA        ExceptionDispatcher() -  Added gNetworkTimeout, gNetworkRetries.
  111. #    <1.1.18>     3/22/94    KTA        Now we handle TargetNames longer than 20 characters.
  112. #    <1.1.17>     3/22/94    KTA        FileTool method of logging TCSes does not support reading the
  113. #                                    Prefs file anymore.
  114. #    <1.1.16>     3/19/94    ML        Output Additional suite info to notebook if gNotebookoutput is
  115. #                                    true
  116. #    <1.1.15>     3/17/94    ML        Output SuiteHeaderInfo to the notebook if gNotebookOutput is
  117. #                                    true.
  118. #    <1.1.14>     3/17/94    ML        added support for logging additional suite info at SuiteEnd time
  119. #                                    for both RE and FT test case logging methods
  120. #    <1.1.13>     3/16/94    ML        generate tcs's for monitor and memory info after suiteheader is
  121. #                                    generated in suitestart()
  122. #    <1.1.12>      3/7/94    KTA        Incorporated Results Express support.
  123. #     <1.1.10>    12/16/93    KTA        Changed the way we handle exception, changed gFileToolOutput to 
  124. #                                    gTestCaseLoggingMethod
  125. #     <1.1.9>    12/13/93    KTA        Added ClearStack() task, and changed the way we handle
  126. #                                    exceptions.
  127. #     <1.1.7>     12/3/93    KTA        ApplicationVerification() if gAppTitle = 'Unknown' turn gAppVerify off. 
  128. #     <1.1.6>     12/3/93    KTA        Logical and physical memory are now reported in bytes, also 
  129. #                                    added SystemArch.
  130. #     <1.1.5>     12/2/93    KTA        Removed isOff, IsOn, VirtualMemory, notAvail, etc
  131. #     <1.1.4>     12/2/93    KTA        Added SystemArchitecture to Suite header. Added
  132. #                                    gSuiteFooterHook, moved call to ApplicationVerification() so it
  133. #                                    would be called when gDBLogging is off, Added gTCSStartHook1.
  134. #     <1.1.3>    11/24/93    NAGA        change "TCS [" to "TEST CASE ["
  135. #     <1.1.2>    11/24/93    NAGA        In LogTCSRecord() change TCSDescription to TCDesc
  136. #    1.0.119>     9/30/93    KTA        TCSEnd() -  pTCSVal no longer defaults to 'NA' and all fields
  137. #                                    which exist will printed in gNoteBook = 2.
  138. #    1.0.118>     9/30/93    KTA        PrintTCSRecord() - Fixed a bug where pTCSVal wouldn't print if
  139. #                                    is was an integer.
  140. #    1.0.117>     9/23/93    KTA        Moved gPreFlight to InitGlobals() and deleted gLaunchReqs, also
  141. #                                    fixed problem where ApplicationVerification() wasn't working.
  142. #    1.0.116>     9/23/93    KTA        LogSuiteHeader() - Commented out Desc field.
  143. #    1.0.115>     9/22/93    KTA        Call the gExceptionDispatcher task reference instead of calling the
  144. #                                    task directly.
  145. #    1.0.114>     9/20/93    KTA        ApplicationVerification() - Retry counter was decremented and it
  146. #                                    should have been incremented.
  147. #    1.0.113>     9/14/93    KTA        WriteTCSRecord() - If trouble with Filetool turn off
  148. #                                    FileToolOutput.        ApplicationVerification() -If gAppTitle
  149. #                                    is not defined turn off Application Verification
  150. #    1.0.112>     9/13/93    KTA        ExceptionDispatcher() - changed TimeOut values,
  151. #                                    ApplicationVerification() - intl - regular expressions errors.
  152. #    1.0.111>     9/13/93    KTA        Updated TestLevel specification.
  153. #    1.0.110>      9/2/93    KTA        Not writing to string 'FileTool output' to prefs file anymore.
  154. #    <1.0.19>      9/1/93    KTA        Changed all calls to VU built in task Exit to call the task
  155. #                                    reference gExitVu instead.
  156. #    <1.0.18>      9/1/93    KTA        Updated task headers and parameters.
  157. #    <1.0.17>     8/25/93    KTA        Added support for parity checking the TCS stack.
  158. #    <1.0.16>     8/23/93    KTA        Realigned fields in output, fixed TCSPassed.
  159. #    <1.0.15>     8/20/93    KTA        TCSStart() - If TCSAttempted is undefined call InitTCSLogging().
  160. #    <1.0.14>     8/20/93    KTA        Changed the return for ReadLine2, so had to update how the
  161. #                                    returnvalue was being used.
  162. #    <1.0.13>     8/20/93    KTA        Added LogSuiteHeader(), LogTCSRecord(), InitTCSLogging(), to
  163. #                                    support FileTool output of Phoenix data.
  164. #    <1.0.12>      8/9/93    KTA        Support for new Pheonix data format.
  165. #    <1.0.11>      8/2/93    KTA        CleanAbort() - Removed gExitFlag.
  166. #    <1.0.10>      8/2/93    KTA        CleanAbort() - Added gExitFlag.
  167. #     <1.0.9>     7/30/93    KTA        TCSEnd() - Changed DialogHandler() call and  added gTCSEndHook1.
  168. #     <1.0.8>     7/20/93    KTA        Bug Fix: failreason was being reinitialized improperly. See
  169. #                                    TCSEnd().
  170. #     <1.0.7>     7/15/93    KTA        Added TCSExpCount: See SuiteEnd()
  171. #     <1.0.6>      7/6/93    KTA        If gDBLogging is not set TCSEnd will not do anything.
  172. #     <1.0.5>      6/8/93    NAGA        unmark tasks that are not published
  173. #     <1.0.4>     5/21/93    NAGA        Adding header and porting old files to follow new standards
  174. #
  175. # ****************************************************************************
  176. #
  177.  
  178. ########################################################################
  179. #                            External libraries 
  180. #=======================================================================
  181. Libraries "Utility.lib","UserInterface.Lib", "Results Express.lib", "Globals.lib", "CrashHandling.lib", "String.Lib", "OutPut.Lib", "TargetCheck.Lib", 'ExceptionHandling.Lib', 'TRACS.Lib';
  182.  
  183.  
  184.  
  185. #########################################################################
  186. #                    InitTCSLogging(pSetupFileToolOutput)
  187. #========================================================================
  188. # Author:        KTA 
  189. # Description:    Initializes globals and <Constants> necessary for generating
  190. #                database records known as TCS (Test Case Specification) records.
  191. # Parameters:    pTestCaseLoggingMethod - The logging method
  192. # Returns:        Nothing
  193. # Examples:        InitTCSLogging(1,1);
  194. # Assumptions:    None 
  195. #========================================================================
  196. # History:
  197. # KTA 3/21/94 Added global gNetworkTimeout, gNetworkRetries
  198. # KTA 9/19/94 Moved globals kNullSuiteID, gCurSuiteID from Results Express.Lib
  199. # ML  11/2/94 Renamed ExceptionDispatcher to TCSExceptionDispatcher to 
  200. #                avoid conflict with ExceptionHandling.lib
  201. # ML 3/8/95   removed gDialoghandling
  202. # KTA 4/11/95   Call isSystem7()
  203. # ML 11/13/95    Move initializing kTCSNoLoggingMethod and kTCSResultsExpressMethod
  204. #                to InitGlobals() - these need to be defined before calling InitTCSLogging.
  205. # ML 1/2/96        add TCS id constant for printing
  206. #########################################################################
  207. TASK InitTCSLogging( pTestCaseLoggingMethod := global gTestCaseLoggingMethod )
  208. begin
  209.  
  210.         ##################################################
  211.         ###    Make sure this task is only executed once per script
  212.     if global TCSLibInitialized
  213.         return 1;
  214.     else
  215.         global TCSLibInitialized := true;
  216.  
  217.         ##################################################
  218.         ###    TCS ID Constants    
  219.     global kTCSetDefault := "UnknownSet";
  220.     global kTCTypeDefault := "Compatibility";
  221.     global kTCOwnerDefault := "SPECS&L";
  222.     global kTCSetLaunch := "Launch";
  223.     global kTCSetQuit := "Quit";
  224.     global kTCSetSFSave := "SFSave";
  225.     global kTCSetRevertDoc := "RevertDoc";
  226.     global kTCSetOpenDoc := "OpenDoc";
  227.     global kTCSetNewDoc := "NewDoc";
  228.     global kTCSetScrapBook := "ScrapBook";
  229.     global kTCSetFont := "Font";
  230.     global kTCSetPageSetup := "PageSetup";
  231.     global kTCSetPrinting := "Printing";
  232.     global kTCSetUIWindowDrag := "UIWindowDrag";
  233.     global kTCSetUIWindowClose := "UIWindowClose";
  234.     global kTCSetUIWindowScroll := "UIWindowScroll";
  235.     global kTCSetUIWindowSize := "UIWindowSize";
  236.     global kTCSetUIWindowMiscOp := "UIWindowMiscOp";
  237.     global kTCSetAboutBox := "AboutBox";
  238.     global kTCSetAppSetup := "AppSetup";
  239.     global kTCSetDraw := "Draw";
  240.     global kTCSetSelectFromPalette := "SelectFromPalette";
  241.     global kTCSetUseTool := "UseTool";
  242.     global kTCSetMemorySize := "Memory Size";    
  243.     global kTCTypeConfig := "Configuration";
  244.     
  245.         ##################################################
  246.         ###    TCS Globals
  247.     global gTCSList                := {};            # TCS Stack
  248.     global kNullSuiteID            := -32767;
  249.     global gCurSuiteID            := kNullSuiteID;
  250.  
  251.         ##################################################
  252.         ###    TCS QuickStat counters
  253.     global TCSAttempted := 0;
  254.     global TCSPassed    := 0;
  255.     global TCSNotAvail    := 0;
  256.     global TCSExpCount    := 0;
  257.  
  258.         ##################################################
  259.         ###    Ensure pTestCaseLoggingMethod is valid
  260.     if IsUndefined( pTestCaseLoggingMethod )
  261.         pTestCaseLoggingMethod := kTCS_TRACSFileToolMethod; 
  262.     
  263.         ##################################################
  264.         ###    Set the global to match the parameter passed in.
  265.     global gTestCaseLoggingMethod := pTestCaseLoggingMethod;
  266.         
  267.         ##################################################
  268.         ###    Misc. Globals needed for the suite header
  269.         ##################################################
  270.         ##################################################
  271.         ### Set target info globals
  272.     try
  273.     begin
  274.         match[system v:?global gBuildVers];
  275.         if not(global gMachineName);
  276.             match[target t:?global gMachineName];
  277.     end;
  278.     catch theError
  279.         ExceptionDispatcher(theError);
  280.  
  281.         ##################################################
  282.         ### Determine if OS has system 7 features
  283.     if(isUndefined(global gIsSys7))
  284.         IsSystem7();    
  285.     
  286.         ##################################################
  287.         ### Task references for exiting allows it to be overridden
  288.     global gExitVU := task ExitVU;    
  289.     
  290.     ##################################################
  291.         ###    Setup the Output method for logging data base records
  292.     SetUpOutput();    
  293. end;
  294.  
  295.  
  296. #########################################################################
  297. #                SuiteStart(pScriptName, pScriptParamList, pScriptVersion)
  298. #========================================================================
  299. # Author:        GS 
  300. # Description:    Start Suite Record.
  301. # Parameters:    pScriptName - Name of the current script 
  302. #                pScriptParamList - list of VU parameters for the current execution
  303. #                pScriptVersion - version of the current script
  304. #                pMatrixID - Id for the matrix.
  305. #                pUseXTools - Flag which indicates whether its ok to use external tools
  306. #                            when building the suite header, Ontarget is used to determine if
  307. #                            filesharing in ON, MemoryMonitor is used to read the ROMBuild.
  308. # Returns:        Nothing
  309. # Examples:        SuiteStart("MacDraw.vu", {1}, '1.1.2');
  310. # Assumptions:    None 
  311. #========================================================================
  312. # History:
  313. # KTA    8/5/93    Rewrote calling PrintSuiteHeader
  314. # KTA    8/9/93    Added ability to output DB Records to Notebook and/or with FileTool
  315. # KTA    9/2/93    Not writing to string 'FileTool output' to prefs file anymore.
  316. # KTA    12/1/93    Not writing to any suite info to notebooks.
  317. # ML    3/16/94    generate tcs's for monitor and memory info
  318. # ML    3/17/94    Output SuiteHeaderInfo to the notebook if gNotebookOutput is true.
  319. # ML    3/23/94    Output Monitor and RAM info to TCSoutput if gAdditionalTargetInfo is true
  320. # KTA    4/1/94    Don't print suiteHeader to noteboook unless gPrintSuiteInfo
  321. # KTA     4/13/94    Changed gDBLogging to gTCTracking
  322. # KTA     4/13/94    Changed RecordRAMFootPrint() to RecordGetAboutThisMacintosh()
  323. # KTA     4/14/94    Added gSuiteStartHook
  324. # KTA     4/21/94    Changed when RecordMonitorInfo and RecordGetAboutThisMacintosh are called.
  325. # KTA     9/20/94    Added global keyword before kNullSuiteID
  326. # KTA     1/16/95    Added pUseXTools
  327. # KTA     2/13/95    Check to see if pUseXTools is true before calling InstallEverytimeMacro.
  328. # KTA     4/14/95 Call InitGlobals() if global gLogStrCount is not defined
  329. # MDF    06/18/96 Added gIsBothMethods to correctly handle both 
  330. #########################################################################
  331. TASK SuiteStart(pScriptName := '', pScriptParamList := '', pScriptVersion := 'xxx', pMatrixID := 0, pUseXTools := 1 )
  332. begin
  333.     global gAppTitleSaveOff := global gAppTitle;    # Used in SuiteEnd() for lab report
  334.     global gSuiteStarted     := 1;                    # Indicates the suite was started
  335.     global gTestCaseLoggingMethod, kTCSResultsExpressMethod,
  336.            kTCS_TRACSFileToolMethod, gIsBothMethods;
  337.  
  338.     if(isUndefined(global gLogStrCount))
  339.         InitGlobals();
  340.         
  341.         ### Logging test cases to a data base
  342.     if (global gTCTracking)
  343.     begin        
  344.             ###    Initialize TCS.Lib for Test Case Logging
  345.         InitTCSLogging();                            # Initialize all globals and <Constants>
  346.         if(global gCrashHandling) and (pUseXTools)
  347.             InstallEveryTimeMacro();                # Will install macro
  348.         
  349.         if(global gSuiteStartHook)
  350.             call(gSuiteStartHook);
  351.         
  352.             ###############################################
  353.             ###    Results Express Method?
  354.         if((gTestCaseLoggingMethod = kTCSResultsExpressMethod) or gIsBothMethods)            
  355.         begin
  356.             LogStr( "TCS Records will be written using Results Express.");
  357.  
  358.             tFields := BuildSuiteFields( pScriptName, pScriptVersion, "{pScriptParamList}" ,pUseXTools);
  359.             
  360.             if (gIsBothMethods)
  361.                 TRACS_DataCollection(tFields, 0);
  362.             
  363.             if (global gPrintSuiteInfo)
  364.             begin
  365.                 for i := 1 to card (tFields)
  366.                     println tFields[i];
  367.             end;
  368.             
  369.              x := NewSuite( pMatrixID, tFields );
  370.             if( x[1] = 0 )
  371.             begin
  372.                 global gCurSuiteID := x[2];
  373.             end;
  374.             else
  375.             begin
  376.                 global gCurSuiteID := global kNullSuiteID;
  377.                 Println "SuiteStart: Failed to create new suite";
  378.                 Println "Error Code   = ", x[1];
  379.                 Println "Error Msg    = ", x[3];
  380.                 Println "Script Error = ", x[4];
  381.             end;
  382.         end;
  383.         else
  384.         begin
  385.             LogStr( "Test Case logging is not being performed.");
  386.             
  387.             if (gTestCaseLoggingMethod = kTCS_TRACSFileToolMethod)
  388.             begin
  389.                 tFields := BuildSuiteFields( pScriptName, pScriptVersion, "{pScriptParamList}" ,pUseXTools);
  390.                 TRACS_DataCollection(tFields, 0);
  391.             end;
  392.         end;
  393.             
  394.             
  395.         ###    You want to write Ram and Monitor info to the TCS output
  396.         AVTemp := global gAppVerify;
  397.         global gAppVerify := 0;
  398.                 
  399.         RecordMonitorInfo();
  400.         If(global gAdditionalTargetInfo)
  401.             RecordGetAboutThisMacintosh(0,0,,,0);
  402.         
  403.         global gAppVerify := AVTemp;
  404.  
  405.     end;
  406.  
  407.     BeginTimer();
  408. end; # SuiteStart
  409.  
  410. #########################################################################
  411. #                            SuiteEnd(pCompletionCode)
  412. #========================================================================
  413. # Author:        GS 
  414. # Description:    End Suite Record. 
  415. # Parameters:    pCompletionCode - Code which indicates success of suite 
  416. #                                1 - Completed successfully
  417. #                                0 - Completed unsuccessfully
  418. # Returns:        Nothing
  419. # Examples:        SuiteEnd(1);
  420. # Assumptions:    none 
  421. #     Additional information concerning global gAdditionalSuiteInfoFT:
  422. #     gAdditionalSuiteInfoFT has been provided to allow additonal information to be written
  423. #     to the suite block.  If there is additonal information that needs to be written to
  424. #    the suite block, gAdditionalSuiteInfoFT needs to be defined as a formatted string. 
  425. #    The string should be defined as 1 or more Phoenix data fields.
  426. #    Each new field should be in the form of "∂t∂t<FieldLabel>:∂t<FieldData>∂n"
  427. #     If there are multiple fields that need to be returned, they should be
  428. #     concatenated and returned as a single string. Note: the default setting is that
  429. #    gAdditionalSuiteInfoFT is undefined and thus nothing will be added to the suite footer
  430. #    unless explicitly defined.
  431. #========================================================================
  432. # History:
  433. # KTA    7/13/93        Added TCSExpCount as per Gil
  434. # KTA    8/4/93        support for new Pheonix data format
  435. # KTA    12/1/93        Not writing to any suite info to notebooks.
  436. # KTA    12/2/93        Added gSuiteFooterHook.
  437. # ML    3/17/94        support for logging additional suite info for both 
  438. #                    RE and FT test case logging methods
  439. # ML    3/20/94        Removed gSuiteFooterHook and added gAdditionalSuiteInfoFT.
  440. # ML    3/17/94        Output additional info to notebook if gNotebookoutput is true
  441. # KTA     4/13/94        Changed gDBLogging to gTCTracking
  442. # KTA     4/14/94        Added gSuiteEndHook
  443. # KTA     4/14/94        Changed SuiteVal to Completion
  444. # KTA     4/28/94        if gPrintSuiteInfo print all suiteFooter fields
  445. # KTA     9/20/94        Added global keyword before kNullSuiteID
  446. # KTA     9/20/94        Added call to CheckForSystemFailure().
  447. # KTA     1/31/95        Added gSuiteEndThreadingHook
  448. #  JC    2/19/96        Added TRACS output support.
  449. # MDF    06/17/96    Modified to check for single digit day if doing TRACS logging
  450. #                    method.
  451. # MDF    06/18/96    Added gIsBothMethods to correctly handle both test case
  452. #                    logging methods.
  453. # MDF    06/18/96    Added support for tracking the number of failed test cases.
  454. #########################################################################
  455. TASK SuiteEnd(pCompletionCode := 1, pCheckIfSystemFailed := 1)
  456. begin
  457.     global gTestCaseLoggingMethod, kTCSResultsExpressMethod, 
  458.            kTCS_TRACSFileToolMethod, gIsBothMethods;
  459.  
  460.     if(global gSuiteStarted) # Suite was started. 
  461.     begin                     # Indicates that SuiteStart was called
  462.         
  463.         if(pCheckIfSystemFailed) and (pCompletionCode)
  464.             CheckforSystemFailure();
  465.             
  466.         if(pCompletionCode = 1)
  467.             Endtimer();
  468.     
  469.         if (global gTCTracking)
  470.         begin
  471.             AdditionalSuiteInfo := '';
  472.             
  473.             global TCSAttempted, TCSPassed,gAppTitleSaveOff,TCSNotAvail, TCSExpCount;
  474.             
  475.             suiteEndTime   := GetCurrentTime(1,0);
  476.             try
  477.                 match[time d:?day m:?month y:?year];
  478.             catch theError
  479.                 ExceptionDispatcher(theError);
  480.             suiteEndDate   := "{month}/{day}/{year}";
  481.                         
  482.                 ###############################################
  483.                 ###    Results Express Method?
  484.             if((gTestCaseLoggingMethod = kTCSResultsExpressMethod) or gIsBothMethods)            
  485.             begin
  486.                  if( not EqualREIDs( global gCurSuiteID, global kNullSuiteID ) )
  487.                 begin
  488.                 
  489.                     tFields :=    {
  490.                                     { 'EndDate    ', suiteEndDate },
  491.                                     { 'EndTime    ', suiteEndTime },
  492.                                     { 'Completion', pCompletionCode }
  493.                                 };
  494.                                 
  495.                     if (global gAddSuiteInfoFieldsRE)
  496.                         tFields := gAddSuiteInfoFieldsRE + tFields;
  497.                         
  498.                     if (global gPrintSuiteInfo)
  499.                     begin
  500.                         for i := 1 to card (tFields)
  501.                             println tFields[i];
  502.                     end;
  503.  
  504.                     x := AddSuiteFields( global gCurSuiteID, tFields );
  505.                     if( x[1] <> 0 )
  506.                     begin
  507.                         Println "SuiteEnd : AddSuiteFields failed";
  508.                     end;
  509.                 end;
  510.                 else
  511.                 begin
  512.                     println "SuiteEnd called when no Current Suite ID was defined";
  513.                 end;                
  514.             end;
  515.             else
  516.                 LogStr( "Test Case logging is not being performed.");
  517.     
  518.             # This is for MatrixCheck - QuickStats
  519.             tab   := "∂t";
  520.             println "¬ ",gAppTitleSaveOff, tab, TCSExpCount, tab, TCSPassed, tab, TCSAttempted, tab, TCSNotAvail, tab, pCompletionCode, tab, tab, suiteEndDate, tab, SuiteEndTime;
  521.             
  522.             if ((gTestCaseLoggingMethod = kTCS_TRACSFileToolMethod) or gIsBothMethods)
  523.             begin
  524.                 monthwithleadingzero := "{month}";             #TRACS needs leading zeros on 1 digit months
  525.                 numChar := Card(monthwithleadingzero);
  526.                 
  527.                 dayWithLeadingZero := "{day}";
  528.                 numDayChar := card(dayWithLeadingZero);
  529.                 
  530.                 if (numChar = 1)
  531.                     monthwithleadingzero := "0" + monthwithleadingzero;
  532.                     
  533.                 if(numDayChar = 1)
  534.                     dayWithLeadingZero := "0" + dayWithLeadingZero;
  535.                 
  536.                 suiteEndDate   := "{monthwithleadingzero}/{dayWithLeadingZero}/{year}";
  537.                 
  538.                 TRACS_Data := {};
  539.             
  540.                 TRACS_Data :=  TRACS_Data + { {"Application title", gAppTitleSaveOff } }; 
  541.             
  542.                 TRACS_Data :=  TRACS_Data + { {"TCS Exp Count", TCSExpCount } };
  543.             
  544.                 TRACS_Data :=  TRACS_Data + { {"TCS Passed", TCSPassed } };
  545.             
  546.                 TRACS_Data :=  TRACS_Data + { {"TCS Failed", (TCSAttempted - TCSPassed - TCSNotAvail)} };
  547.  
  548.                 TRACS_Data :=  TRACS_Data + { {"TCS Attempted", TCSAttempted } };
  549.  
  550.                 TRACS_Data :=  TRACS_Data + { {"TCS Not Avail", TCSNotAvail } };
  551.             
  552.                 TRACS_Data :=  TRACS_Data + { {"Suite Completion Code", pCompletionCode } };
  553.  
  554.                 TRACS_Data :=  TRACS_Data + { {"Suite End Date", suiteEndDate } };
  555.             
  556.                 TRACS_Data :=  TRACS_Data + { {"Suite End Time", SuiteEndTime } };
  557.  
  558.                 TRACS_DataCollection(TRACS_Data, 1);
  559.             end;
  560.             
  561.             if(global gSuiteEndHook)
  562.                 call(gSuiteEndHook);
  563.         end;
  564.     end; # The suite was never started
  565.     if(global gSuiteEndThreadingHook)
  566.         call(gSuiteEndThreadingHook);
  567. end;
  568.  
  569. #########################################################################
  570. #                            TCSStart(pTCSId, pTextDesc, pAppName)
  571. #========================================================================
  572. # Author:        GS 
  573. # Description:    Start TCS Record.
  574. # Parameters:    pTCSId -  The TCS Id that results are being recorded for (list)
  575. #                            1st element - Test Case number  (integer)
  576. #                            2nd element - Test Case Set        (string)
  577. #                            3rd element - Test Case Type    (string)
  578. #                            4th element - Test Case Owner    (string)
  579. #                pTextDesc - string that describes the Test Case
  580. #                pAppName - defaults to gAppTitle, otherwise the name of the 
  581. #                            application the Test Case applies to
  582. # Returns:        Nothing
  583. # Examples:        TCSStart();
  584. # Assumptions:    None 
  585. #========================================================================
  586. # History:
  587. # KTA    8/20/93        If TCSAttempted is undefined call InitTCSLogging()
  588. # KTA    12/01/93    Added gTCSStartHook1, and moved ApplicationVerification
  589. #                    so it will be called even if gDBLogging is off
  590. # KTA    3/22/94    Turn gDBLogging OFF if SuiteStart() was no called.
  591. # KTA     4/13/94    Changed gDBLogging to gTCTracking
  592. # KTA     5/11/94    Removed support for elapsed time field in TCS
  593. # KTA     1/16/95    Added a try/catch block for the match
  594. # KTA     1/18/95    Added pTargetAlive so you can indicate whether its OK to 
  595. #                match the target or not/ also removed gAppIdentifier.
  596. #########################################################################
  597. TASK TCSStart(pTCSId, pTextDesc, pAppName := global gAppTitle, pTargetAlive := 1)
  598. begin
  599.     if(global gTCSStartHook1)
  600.         Call(gTCSStartHook1);
  601.         
  602.     if (TCTrackingOrNot(pTCSId))
  603.     begin
  604.         if not(global gSuiteStarted)
  605.         begin
  606.             LogStr("Note: SuiteStart() was not called prior to making a TCS call - turning TCS logging OFF");
  607.             global gTCTracking := 0;
  608.             Return(0);
  609.         end;
  610.         
  611.         global TCSAttempted := TCSAttempted + 1;
  612.         pTCSId := FillTCSId( pTCSId );
  613.  
  614.         if not (pAppName)                    # If AppName is not defined, define it.
  615.         begin
  616.             try
  617.             begin
  618.                 if(pTargetAlive)
  619.                     Match[application t:?pAppName];
  620.                 else
  621.                     pAppName := 'Unknown';
  622.             end;
  623.             catch theError
  624.                 ExceptionDispatcher(theError);
  625.         end;
  626.         
  627.         thisTCS               := {pTCSId, pTextDesc, pAppName};
  628.         TCSPush(thisTCS);
  629.     end;
  630.     
  631.     if (global gAppVerify) and (pTargetAlive)        # Verify that the correct Application is running
  632.         ApplicationVerification(1);
  633. end;
  634.  
  635. #########################################################################
  636. #        TCSEnd(pTCSId,pResultCode, pErrStr, pTCSVal, pTCSStr, pCommentStr)
  637. #========================================================================
  638. # Author:        GS 
  639. # Description:    This task is called when the functionality of the pending TCS 
  640. #                is complete.  It will pop the top TCS record from the TCS stack,
  641. #                check to insure the TCS numbers match.  If the result code (<pResultCode>)
  642. #                is 0 a check will be done to insure no unexpected dialogs are present.
  643. #                A call to ExceptionDispatcher() is made to insure that no VU errors were 
  644. #                encountered. Then the appropriate output task is called to output the 
  645. #                data.  
  646. # Parameters:    pTCSId -  The TCS Id that results are being recorded for (list)
  647. #                            1st element - Test Case number  (integer)
  648. #                            2nd element - Test Case Set        (string)
  649. #                            3rd element - Test Case Type    (string)
  650. #                            4th element - Test Case Owner    (string)
  651. #                pResultCode - The result of the TCS on top of Stack (Lifo)
  652. #                pErrStr - Reason for failure if known.
  653. #                pTCSVal - Any value a TCS needs to return for additional info.
  654. #                pTCSStr - Any string a TCS needs to return for additional info.
  655. #                pCommentStr - A string the TCS can return results in.
  656. #                pBailFlag     - incase of critical error we may need to dump the stack
  657. #                                - 'NoRecursion' this will avoid recursion 
  658. #                                - any integer will bail the suite with the value of the integer    
  659. # Returns:        Nothing
  660. # Examples:        TCSEnd();
  661. # Assumptions:    None 
  662. #========================================================================
  663. # History:
  664. # KTA    7/6/93        If not gDBLogging TCSEnd will not do anything
  665. # KTA    7/20/93        Failreason was being reinitialized thus destroying any parameter data.
  666. # KTA    7/28/93        Added gTCSEndHook1 and reworked dialogHandler
  667. # KTA    8/05/93        Support for new Pheonix data format
  668. # KTA    8/09/93        Added pDumpStack parameter
  669. # KTA    8/24/93        TCS stack parity check
  670. # KTA    12/01/93    moved gTCSEndHook1 so it will be called even if gDBLogging is off.
  671. # KTA    12/1/93        Not writing total TestCase info to notebooks.
  672. # KTA    12/13/93    Changed parameter pDumpStack to pBailFlag
  673. # KTA    3/24/94        Changed DialogHandler() thus had to change call.
  674. # KTA    3/24/94        Added gLastResortHook()
  675. # KTA     4/13/94        Changed gDBLogging to gTCTracking
  676. # KTA     5/11/94        Call ExceptionDispatcher prior to popping TCS from stack.
  677. # KTA    5/11/94        ExceptionDispatcher doesn't supported elapsed time anymore.
  678. # KTA     5/11/94        Removed support for elapsed time field in TCS
  679. # KTA     9/20/94        Added global keyword before kNullSuiteID
  680. # KTA     1/17/95        Added CheckforSystemFailure()
  681. # KTA     1/31/95        Added gTCSEndThreadingHook
  682. # ML    2/16/95        Set pResultCode to 0 if CheckforSystemFailure() is true
  683. # KTA    2/28/95        Don't check for unexpected dialogs if pBailFlag set.
  684. # MDF    06/18/96    Added gIsBothMethods to correctly handle both test case
  685. #                    logging methods.
  686. #########################################################################
  687. TASK TCSEnd(pTCSId := {}, pResultCode := '', pErrStr := '', pTCSVal := '', pTCSStr := '', pCommentStr := '', pBailFlag := '')
  688. begin
  689.     global gTestCaseLoggingMethod, kTCSResultsExpressMethod, gIsBothMethods;
  690.  
  691.     if(global gTCSEndHook1)
  692.         Call (gTCSEndHook1, TopOfTCSStack());
  693.         
  694.     if (TCTrackingOrNot(pTCSId))
  695.     begin
  696.         if (pBailFlag = '')                # Check if the system died
  697.             if (CheckforSystemFailure())
  698.                 pResultCode:= 0;
  699.             
  700.         thisTCS := TCSPop();                # Pop the current TCS    
  701.         #### TCS Parity check - are we working with the right TCS???
  702.         StackTCSId := thisTCS[1];
  703.         if (StackTCSId[1] <> pTCSId[1]) or (StackTCSId[2] <> pTCSId[2])
  704.         begin
  705.             println "    TCS mismatched : TOS -  ", StackTCSId, ", Passed in - ", pTCSId;
  706.             println "    Exiting Script - the TCS stack is unbalanced";
  707.             call (global gExitVU);
  708.         end;
  709.  
  710.         if (typeOf(pResultCode) = 'string')    # if embedded task returns string, i.e. selectmenuitem
  711.             pResultCode:=1;                    # set pResultCode to success
  712.  
  713.         #### Handle unexpected dialogs
  714.         if (pResultCode = 0) and (pBailFlag = '')                 # dialogCheck for pResultCode < 0
  715.         begin
  716.             theDialoglist := DialogHandler();
  717.             theResult :=  theDialoglist[1];
  718.             StaticTextString := theDialoglist[2];
  719.  
  720.             if (theResult <> -1)            # No dialogs were present
  721.             begin
  722.                 if(theResult >= 1)            # Unexpected dialogs that we were able to dismiss
  723.                     pCommentStr := pCommentStr + "Dismissed unexpected dialogs : " + StaticTextString;
  724.                 else if((theResult = 0)    and (global gLastResortHook))
  725.                 begin
  726.                     pErrStr   := pErrStr +  "NOTE: Calling gLastResortHook() because of failure in infinite dialog loop - {StaticTextString}";
  727.                      call(gLastResortHook);
  728.                 end;
  729.                 else if(theResult = 0)        # Unexpected dialogs that we weren't able to dismiss
  730.                 begin
  731.                     pErrStr   := pErrStr +  "Failed in infinite dialog loop - {StaticTextString}";
  732.                     pBailFlag := 0;            # Abort suite fail with a 0
  733.                 end;
  734.             end;
  735.         end;
  736.         else if (pResultCode < 0)            # QuickStats
  737.             global TCSNotAvail := TCSNotAvail + 1;
  738.         else if (pResultCode > 0)
  739.             global TCSPassed := TCSPassed + 1;
  740.                         
  741.         ### Output database records to the NoteBook
  742.             PrintTCSRecord(thisTCS, pResultCode, pErrStr, pTCSVal, pTCSStr, pCommentStr);
  743.  
  744.         ### Output database records using Results Express ?
  745.         if((gTestCaseLoggingMethod = kTCSResultsExpressMethod) or gIsBothMethods)    
  746.         begin
  747.             if( not EqualREIDs( global gCurSuiteID, global kNullSuiteID ) )
  748.             begin
  749.                 tFields := BuildTCSFields( thisTCS, pResultCode, pErrStr, pTCSVal, pTCSStr, pCommentStr);
  750.                 x := NewTestCase( global gCurSuiteID, tFields );
  751.                 if( x[1] <> 0 )
  752.                     Println "EndSuite : NewTestCase failed";
  753.             end;
  754.             else
  755.                 println "TCSEnd called when no Current Suite ID was defined";
  756.         end;
  757.  
  758.         if not(pBailFlag = '') and not(pBailFlag = 'NoRecursion')        # Bail the suite
  759.             CleanAbort(pErrStr,pBailFlag);
  760.     end;
  761.     if(global gTCSEndThreadingHook)
  762.         call (gTCSEndThreadingHook);
  763. end;  # TCSEnd
  764.  
  765.  
  766.  
  767. #########################################################################
  768. #                        SetUpOutput()
  769. #========================================================================
  770. # Author:        KTA
  771. # Description:    if global gTestCaseLoggingMethod = global kTCSResultsExpressMethod
  772. #                ResultsExpress will be initialized.
  773. # Parameters:    none
  774. # Returns:        Nothing
  775. # Examples:        SetUpOutput(1);
  776. # Assumptions:    
  777. #========================================================================
  778. # History:
  779. # KTA    12/1/93        Not writing total TestCase info to notebooks.
  780. # KTA    3/22/94        Not reading Prefs file anymore when using kTCSFileToolMethod.
  781. # KTA    3/22/94        Handle TargetNames > 20 characters
  782. # KTA    12/7/94        Removed FileTool logging method
  783. # ML    3/23/95        Temporarily set CommandExceptions off when calling
  784. #                    InitResultsExpress() so we don't throw if it fails
  785. # MDF    06/18/96    Added gIsBothMethods to correctly handle both test case
  786. #                    logging methods.
  787. #########################################################################
  788. task SetUpOutput()
  789. begin
  790.     global gTestCaseLoggingMethod, kTCSResultsExpressMethod, gIsBothMethods;
  791.     
  792.     ##################################################
  793.     ###    If using kTCSResultsExpressMethod for logging Test Cases
  794.     ###     then initialize Results Express as an external tool
  795.     if((gTestCaseLoggingMethod = kTCSResultsExpressMethod) or gIsBothMethods)
  796.     begin
  797.         tempCommandExceptions := CommandExceptions(0);
  798.         x := InitResultsExpress();
  799.         CommandExceptions(tempCommandExceptions);
  800.         if( x[1] <> 0 )
  801.         begin
  802.             Println "Failed to initialize the 'Results Express' external tool";
  803.             Println "Error Code   = ", x[1];
  804.             Println "Error Msg    = ", x[3];
  805.             Println "Script Error = ", x[4];
  806.             Println "Test Case logging is now turned OFF"; 
  807.             gTestCaseLoggingMethod := 0;    # no logging
  808.         end;
  809.     end;
  810. end; # SetUpOutput
  811.  
  812. #########################################################################
  813. #                            FillTCSId( pTCSId )
  814. #========================================================================
  815. # Author:        naga
  816. # Description:    Start TCS Record.
  817. # Parameters:    pTCSId
  818. # Returns:        new complete TCSId ( a list of 4 elements)
  819. # Examples:        newId := FillTCSId( oldId );
  820. # Assumptions:    None 
  821. #========================================================================
  822. # History:
  823. # KTA    12/7/94    Direct list assignment
  824. #########################################################################
  825. TASK FillTCSId( pTCSId )
  826. begin
  827.     if (TypeOf(pTCSId) = 'list')
  828.     begin
  829.         if (IsUndefined(pTCSId[1]))
  830.             pTCSId[1] := 0;
  831.         else if (TypeOf(pTCSId[1]) <> 'integer')
  832.             pTCSId[1] := 0;
  833.     
  834.         if (IsUndefined(pTCSId[2]))
  835.             pTCSId[2] := global kTCSetDefault;
  836.         else if (TypeOf(pTCSId[2]) <> 'string')
  837.             pTCSId[2] := global kTCSetDefault;
  838.     
  839.         if (IsUndefined(pTCSId[3]))
  840.             pTCSId[3] := global kTCTypeDefault;
  841.         else if (TypeOf(pTCSId[3]) <> 'string')
  842.             pTCSId[3] := global kTCTypeDefault;
  843.     
  844.         if (IsUndefined(pTCSId[4]))
  845.             pTCSId[4] := global kTCOwnerDefault;
  846.         else if (TypeOf(pTCSId[4]) <> 'string')
  847.             pTCSId[4] := global kTCOwnerDefault;
  848.  
  849.         return pTCSId;
  850.     end;
  851.     else    # Not a list 
  852.     begin
  853.         println "!!!! Improper TCS Id -- ", pTCSId, " !!!!" ;
  854.         if (TypeOf(pTCSId) = 'integer') #if using old style numeric Id
  855.             return { pTCSId, global kTCSetDefault, global kTCTypeDefault, global kTCOwnerDefault }; 
  856.         else
  857.             return { 0, global kTCSetDefault, global kTCTypeDefault, global kTCOwnerDefault };
  858.     end;
  859. end;
  860.  
  861. #########################################################################
  862. #        PrintTCSRecord(pTCSRecord, pResultCode, pErrStr, pTCSVal, pTCSStr, pCommentStr)
  863. #========================================================================
  864. # Author:        KTA 
  865. # Description:    Prints TCS record information to the notebook.
  866. # Parameters:    pTCSRecord - The current TCS Record from top of stack
  867. #                pResultCode - Result of the TCS
  868. #                pCommentStr - String provided for returning results
  869. #                pTCSVal - field for TCS specific values
  870. #                pTCSStr - field for TCS specific strings
  871. #                pErrStr - String for explaining failure
  872. # Returns:        Nothing
  873. # Examples:        PrintTCSRecord();
  874. # Assumptions:    None 
  875. #========================================================================
  876. # History:
  877. # KTA    8/09/93     Added check to see if field exist before printing it.
  878. # KTA    9/30/93     Fixed a bug where pTCSVal wouldn't print if is was an integer
  879. # KTA    9/30/93     Print all fields for gNoteBookOutput = 2 if they exist
  880. # KTA    12/01/93 Can no longer print complete Test Case output to notebooks
  881. # KTA    9/19/94  Added global keyword
  882. # KTA    9/20/94  Added Print •• if not pResultCode
  883. # KTA    12/7/94  Changed order of parameters and print statements
  884. # KTA    12/12/94  Removed reference to gNotebookOutput
  885. #########################################################################
  886. task PrintTCSRecord(pTCSRecord, pResultCode, pErrStr, pTCSVal, pTCSStr, pCommentStr)
  887. begin
  888.     if(pResultCode )
  889.         theChar := '•';
  890.     else
  891.         theChar := '••';
  892.     
  893.     println "        {theChar}TCS - ", pTCSRecord[1], ", ",pTCSRecord[2], ", ", pResultCode, ", ", pErrStr, ", ", pTCSVal, ", ", pTCSStr, ", ", pCommentStr;
  894. end;
  895.  
  896. #########################################################################
  897. #        BuildSuiteFields( pScriptName, pScriptVersion, pScriptParameterList, pUseXTools)
  898. #========================================================================
  899. # Author:        RV
  900. # Description:    Outputs suite header information utilizing Results Express
  901. # Parameters:    pScriptName         - Name of the current script
  902. #                pScriptVersion         - Version of the current script
  903. #                pScriptParameterList - Parameters to the current script
  904. #                pUseXTools -Flag which indicates whether its ok to use external tools
  905. #                            when building the suite header, Ontarget is used to determine if
  906. #                            filesharing in ON, MemoryMonitor is used to read the ROMBuild.
  907. # Returns:        Nothing
  908. # Examples:        LogSuiteHeader("MacDraw", '1.0',{1});
  909. # Assumptions:    None 
  910. #========================================================================
  911. # History:
  912. # KTA    9/23/93    Commented out Desc field as we can't get any useful info for this field yet.
  913. # KTA    4/1/94    'SuiteParams' - label was misnamed 'SeedValue'.
  914. # KTA     4/5/94    Added 'MachineType'
  915. # KTA    4/19/94    Changed SuiteVers to SuiteVer
  916. # KTA    4/27/94    Changed AppVers to AppVer
  917. # KTA    1/16/95    Added OSVersion and ROMBuild support
  918. # KTA    1/16/95    Added pUseXTools
  919. #  JC    2/19/96        Added TRACS output support.
  920. #########################################################################
  921. task BuildSuiteFields( pScriptName := 'na', pScriptVersion := 'na', pScriptParameterList := "", pUseXTools := 1)
  922. begin
  923.     SuiteHeaderString := "∂n∂n";
  924.     
  925.     tSuiteFields := {};
  926.         
  927.         ###    Get a bunch of info
  928.     theMachineState := MachineState(,pUseXTools);
  929.     
  930.         ###    TargetName
  931.     tSuiteFields := tSuiteFields + { { "TargetName", assoc('TargetName', theMachineState) } };
  932.             
  933.         ###    MachineType
  934.     tSuiteFields := tSuiteFields + { { "MachineType", assoc('MachineType', theMachineState) } };
  935.             
  936.         ###    AppName
  937.     if not( global gAppTitle )
  938.         gAppTitle := 'Unknown';
  939.     tSuiteFields := tSuiteFields + { { "AppName", gAppTitle } };
  940.             
  941.         ###    AppVersion
  942.     if ( global gAppVersion )
  943.         tSuiteFields := tSuiteFields + { { "AppVer", gAppVersion } };
  944.             
  945.         ###    ScriptName
  946.     tSuiteFields := tSuiteFields + { { "SuiteName", pScriptName } };
  947.     
  948.         ###    ScriptVersion
  949.     tSuiteFields := tSuiteFields + { { "SuiteVer", pScriptVersion } };
  950.     
  951.          ###    SystemVersion
  952.     tSuiteFields := tSuiteFields + { { "OSVersion", assoc('OSVersion', theMachineState) } };
  953.     
  954.          ###    ROM Build
  955.     tSuiteFields := tSuiteFields + { { "ROMBuild", assoc('ROMBuild', theMachineState) } };
  956.     
  957.         ###    SuiteStartDate
  958.     Try
  959.     begin
  960.         match[time d:?day m:?month y:?year];
  961.         tSuiteFields := tSuiteFields + { { "StartDate", "{month}/{day}/{year}" } };
  962.     end;
  963.     catch theError
  964.         ExceptionDispatcher(theError);
  965.     
  966.         ###    SuiteStartTime
  967.     suiteStartTime := GetCurrentTime(1,0);
  968.     tSuiteFields := tSuiteFields + { { "StartTime", SuiteStartTime } };
  969.  
  970.         ###    Description
  971. #    tSuiteFields := tSuiteFields + { { "Desc", "Just say 'Ship It'" } };
  972.         
  973.         ###    SeedValue
  974.     tSuiteFields := tSuiteFields + { { "SeedValue", global gSeedValue } };
  975.  
  976.         ###    SuiteParams
  977.     drawMethod        :=  "gDrawLevel := {global gDrawLevel}; ";
  978.     WindowMethod    :=  "gWindowLevel := {global gWindowLevel}; ";
  979.     FontMethod        :=  "gFontLevel := {global gFontLevel};";
  980.     globList         :=     drawMethod + WindowMethod + FontMethod;
  981.     tSuiteFields := tSuiteFields + { { "SuiteParams", pScriptParameterList + " " + globList } };
  982.  
  983.         ###    AddrMode
  984.     tSuiteFields := tSuiteFields + { { "AdMode32", assoc('AddrMode', theMachineState) } };
  985.  
  986.         ###    LogicalMem
  987.     tSuiteFields := tSuiteFields + { { "LogicalMem", assoc('LogicalMem', theMachineState) } };
  988.     
  989.         ###    PhysicalMem
  990.     tSuiteFields := tSuiteFields + { { "PhysicalMem", assoc('PhysicalMem', theMachineState) } };
  991.     
  992.         ###    VM
  993.     tSuiteFields := tSuiteFields + { { "VM", assoc('VM', theMachineState) } };
  994.  
  995.          ###    FileSharing
  996.     tSuiteFields := tSuiteFields + { { "FileShare", assoc('FileShare', theMachineState) } };
  997.     
  998.          ###    Cache
  999.     tSuiteFields := tSuiteFields + { { "Cache", assoc('cache', theMachineState) } };
  1000.     
  1001.     return tSuiteFields;
  1002. end;
  1003.  
  1004. #########################################################################
  1005. #    BuildTCSFields(pTCSRecord, pResultCode, pErrStr, pTCSVal, pTCSStr, pCommentStr )
  1006. #========================================================================
  1007. # Author:        RV
  1008. # Description:    Builds a list of fields for the TCS record for use with Results Express.
  1009. # Parameters:    pTCSRecord - The current TCS Record from top of stack
  1010. #                pResultCode - Result of the TCS
  1011. #                pCommentStr - String provided for returning results
  1012. #                pTCSVal - field for TCS specific values
  1013. #                pTCSStr - field for TCS specific strings
  1014. #                pErrStr - String for explaining failure
  1015. # Returns:        list of fields (e.g. list of Label/Value pairs)
  1016. # Examples:        BuildTCSFields(thisTCS,1);
  1017. # Assumptions:    None 
  1018. #========================================================================
  1019. # History:
  1020. # KTA    9/14/93    If trouble with Filetool turn off fileToolOutput
  1021. # KTA     5/11/94    Removed support for elapsed time field in TCS
  1022. # KTA     9/21/94    Added support for TCName
  1023. # KTA     12/7/94    if not( pTCSVal = '')
  1024. #########################################################################
  1025. task BuildTCSFields(pTCSRecord, pResultCode, pErrStr, pTCSVal, pTCSStr, pCommentStr )
  1026. begin    
  1027.     tFields := {};
  1028.  
  1029.         ###    Test Case Number
  1030.         ###    Test Case Set
  1031.         ###    Test Case Type
  1032.         ###    Test Case Owner
  1033.     tFields := tFields    + {    { 'TCNo    ',        pTCSRecord[1][1] },
  1034.                             { 'TCSet    ',    pTCSRecord[1][2] },
  1035.                             { 'TCType    ',    pTCSRecord[1][3] },
  1036.                             { 'TCOwner    ',    pTCSRecord[1][4] }
  1037.                           };
  1038.  
  1039.         ###    Test Case Name
  1040.     theTCName := pTCSRecord[1][5];
  1041.     if(theTCName)
  1042.         tFields := tFields    + {{ 'TCName',    theTCName }};
  1043.     
  1044.         ###    Test Case Description
  1045.         ### Test Case Result
  1046.     tFields := tFields    + {    { 'TCDesc    ',    pTCSRecord[2] },
  1047.                             { 'Result    ',    pResultCode }
  1048.                           };
  1049.         ###    Result String
  1050.     if( pCommentStr )
  1051.         tFields := tFields    + {{ 'Comments',    pCommentStr }};
  1052.  
  1053.         ###    Result Value
  1054.     if not( pTCSVal = '')
  1055.         tFields := tFields    + {{ 'NumericVal',    pTCSVal }};
  1056.  
  1057.         ###    Text Value
  1058.     if( pTCSStr )
  1059.         tFields := tFields    + {{ 'TextVal    ',    pTCSStr }};
  1060.  
  1061.         ###    Error Description
  1062.     if( pErrStr )
  1063.         tFields := tFields    + {{ 'ErrDesc    ',    pErrStr }};
  1064.     
  1065.     return tFields;
  1066. end;
  1067.  
  1068.  
  1069. #########################################################################
  1070. #                    TopOfTCSStack()
  1071. #========================================================================
  1072. # Author:        KTA 
  1073. # Description:    Returns the top element of TCS stack.
  1074. # Parameters:    nothing
  1075. #                
  1076. # Returns:        thisTCS - TCS from the top of the stack
  1077. # Examples:        myTCS := TopOfTCSStack();
  1078. # Assumptions:    None 
  1079. #========================================================================
  1080. # History:
  1081. #
  1082. #########################################################################
  1083. task TopOfTCSStack()
  1084. begin
  1085.     return(global gTCSList[card(gTCSList)]);
  1086. end;
  1087.  
  1088. #########################################################################
  1089. #                    TCSPop()
  1090. #========================================================================
  1091. # Author:        KTA 
  1092. # Description:    Pops the top element from the stack and returns it.
  1093. # Parameters:    nothing
  1094. #                
  1095. # Returns:        thisTCS - TCS record from the top of the stack
  1096. # Examples:        myTCS := TCSPop();
  1097. # Assumptions:    None 
  1098. #========================================================================
  1099. # History:
  1100. # KTA    12/7/94    Removed gDebugFlag
  1101. #########################################################################
  1102. task TCSPop()
  1103. begin
  1104.     global gTCSList;
  1105.     thisTCSPos := card(gTCSList);
  1106.     thisTCS        := gTCSList[thisTCSPos];
  1107.     gTCSList := remove(thisTCSPos, gTCSList); #decrement the stack
  1108.     return(thisTCS);
  1109. end;
  1110.  
  1111. #########################################################################
  1112. #                    TCSPush(pThisTCS)
  1113. #========================================================================
  1114. # Author:        KTA 
  1115. # Description:    Push <pThisTCS> onto the stack
  1116. # Parameters:    pThisTCS - TCS record to push onto the stack
  1117. #                
  1118. # Returns:        Nothing
  1119. # Examples:        TCSPush(myTCS);
  1120. # Assumptions:    None 
  1121. #========================================================================
  1122. # History:
  1123. # KTA    12/7/94    Direct list assignment
  1124. #########################################################################
  1125. task TCSPush(pThisTCS)
  1126. begin
  1127.     global gTCSList[card(gTCSList) + 1] := pThisTCS;
  1128. end;
  1129.  
  1130. #########################################################################
  1131. #                    ClearStack(pFailReason)
  1132. #========================================================================
  1133. # Author:        KTA 
  1134. # Description:    Pops all of the TCSes from the TCS stack appropriately failing
  1135. #                them with an error code of -1 
  1136. # Parameters:    pFailReason - Reason for failing TCS that is at the top of the stack.
  1137. # Returns:        Nothing
  1138. # Examples:        ClearStack('I wanted to');
  1139. # Assumptions:    None 
  1140. #========================================================================
  1141. # History:
  1142. # KTA 12/13/93    Created
  1143. # KTA 5/11/94    We were clearing the stack in the wrong order
  1144. # KTA 5/12/94    0 for the top TCS and -1 for all the rest.
  1145. #########################################################################
  1146. TASK ClearStack(pAbortReason := '')
  1147. begin
  1148.     numTCSes := Card(global gTCSList);
  1149.     whichTCS := numTCSes;
  1150.     for i := 1 to numTCSes
  1151.     begin
  1152.         thisTCS    := gTCSList[whichTCS];
  1153.         TCSNum := thisTCS[1];
  1154.         if (i = 1)        # The current fail reason should only belong to the top of the stack
  1155.             TCSEnd(TCSNum, 0, pAbortReason,,,,'NoRecursion');
  1156.         else 
  1157.             TCSEnd(TCSNum, -2, "The previous TCS created a critical failure",,,,'NoRecursion');
  1158.         
  1159.         whichTCS     := whichTCS - 1;
  1160.     end;
  1161. end;
  1162.  
  1163.  
  1164. #########################################################################
  1165. #        CleanAbort(pFailReason, pSuiteComplete := 0)
  1166. #========================================================================
  1167. # Author:        GS 
  1168. # Description:    Dumps the TCS stack appropriately failing the TCS's that 
  1169. #                couldn't be completed. Then releases the target, and exits 
  1170. #                the script
  1171. # Parameters:    pFailReason - Reason for failing TCS.
  1172. #                pSuiteComplete - Completion Code for Suite.
  1173. # Returns:        Nothing
  1174. # Examples:        CleanAbort();
  1175. # Assumptions:    None 
  1176. #========================================================================
  1177. # History:
  1178. # KTA 9/1/93    Updated so only the TCS record at the top of the stack will
  1179. #                fail with a 0, all others fail with -1 (expected fail)
  1180. # KTA 12/13/93    Moved functionality of clearing the stack to it's own task - ClearStack().
  1181. # KTA    5/11/94        CleanAbort doesn't supported elapsed time anymore.
  1182. # KTA    2/2/95        Removed Releasing the target
  1183. #########################################################################
  1184. task CleanAbort(pAbortReason := '', pSuiteComplete := 0)
  1185. begin        
  1186.     println "Aborting Script";
  1187.     
  1188.     ClearStack(pAbortReason);
  1189.     
  1190.     SuiteEnd(pSuiteComplete,0);
  1191.     
  1192.     call (global gExitVU);
  1193. end;
  1194.  
  1195. #########################################################################
  1196. #                ApplicationVerification(pAppVerify)
  1197. #========================================================================
  1198. # Author:        KTA 
  1199. # Description:    Verify that the current Application is the same as the global
  1200. #                gAppTitle.  If not successfull, Abort of script will occur thru
  1201. #                ExceptionDispatcher().
  1202. # Parameters:    pAppVerify - 1 := will make the check
  1203. #                            0 := will not make the check
  1204. # Returns:        nothing
  1205. # Examples:        ApplicationVerification(1);
  1206. # Assumptions:    None 
  1207. #========================================================================
  1208. # History:
  1209. # KTA    9/14/93    If gAppTitle is not defined turn off Application Verification
  1210. # KTA    9/20/93    Retry counter was decremented and it should have been incremented
  1211. # KTA    9/22/93    theAppTitle was undefined
  1212. # KTA    12/06/93    if gApptitle =  'Unknown' turn off gAppVerify
  1213. # KTA    3/24/94        Define gAppTitle even if we've turned off gAppVerify.
  1214. # KTA    5/11/94        ExceptionDispatcher doesn't supported elapsed time anymore.
  1215. #########################################################################
  1216. task ApplicationVerification(pAppVerify := 0)
  1217. begin
  1218.     if (pAppVerify) and (Global gAppVerify)
  1219.     begin
  1220.         if not(global gAppTitle) or (gApptitle =  'Unknown')
  1221.         begin
  1222.             LogStr("The global 'gAppTitle' was not defined turning OFF the Application Verfication scheme");
  1223.             global gAppVerify := 0;
  1224.             gAppTitle := _Match([application]).t;
  1225.         end;
  1226.         else
  1227.         begin
  1228.             retry := 0;
  1229.             while not( _match([application t:gAppTitle]))     # assume target crashed if app name not match
  1230.             begin
  1231.                 if (retry < 2)
  1232.                 begin
  1233.                     Try
  1234.                     begin
  1235.                         match[menuitem t:gAppTitle m:[menu t:?Menutitle]];
  1236.                         Select[MenuItem t:gAppTitle m:[menu t:Menutitle]];
  1237.                         wait(3);
  1238.                     end;
  1239.                     catch theError
  1240.                         ExceptionDispatcher(theError);
  1241.                     retry := retry + 1;
  1242.                 end;
  1243.                 else 
  1244.                 begin
  1245.                     theAppTitle := _Match([application]).t;
  1246.                     KeyEq('q');        # Quit
  1247.                     Println "*** Failed Application Verification - aborting script and typing key Equivalent 'Q'";
  1248.                     Println;
  1249.                     CleanAbort("Failed app verification scheme - *** Current app: '{theAppTitle}'   *** Expected app: '{gAppTitle}'");
  1250.                 end;
  1251.             end;
  1252.         end;
  1253.     end;
  1254. end; # ApplicationVerification()
  1255.  
  1256.  
  1257. #########################################################################
  1258. #            TCTrackingOrNot(pTCID)
  1259. #========================================================================
  1260. # Author:        KTA 
  1261. # Description:    Determines if individual TCSes should be tracked or not by 
  1262. #                comparing the value of <pTCID> with the global gTCTracking.
  1263. #                    If gTCTracking = 0 - no Test Cases will be tracked.
  1264. #                    If gTCTracking = 1 - all Test Cases will be tracked.
  1265. #                    If gTCTracking = <list> - only the Test Cases that have a pTCID
  1266. #                        which is in the list will be tracked.
  1267. #                
  1268. # Parameters:    pTCID - The pTCID from a call to TCSStart and/or TCSEnd
  1269. # Returns:        0 - don't perform Test Case tracking
  1270. #                1 - perform Test Case tracking
  1271. # Examples:        TCTrackingOrNot("Performance");
  1272. # Assumptions:    
  1273. #========================================================================
  1274. # History:
  1275. # KTA 4/14/94     Created
  1276. # KTA 4/15/94     Changed way to determine if were going to track the TCS to use
  1277. #                the TCID instead or requiring an additional symbol.
  1278. #########################################################################
  1279. task TCTrackingOrNot(pTCID)
  1280. begin
  1281.     returnVal := 0;
  1282.     global gTCTracking;
  1283.     if (gTCTracking)
  1284.     begin
  1285.         if(gTCTracking = 1)
  1286.             returnVal := 1;
  1287.         else if (Typeof(gTCTracking) = 'list')
  1288.         begin
  1289.             if (isMember(pTCID,gTCTracking))
  1290.                 returnVal := 1;
  1291.             else
  1292.             begin
  1293.                 numTimes := Card(gTCTracking);
  1294.                 for iterations := 1 to numTimes            # For each TC specifier in gTCTracking
  1295.                 begin
  1296.                     TrackedTC := gTCTracking[iterations];
  1297.                     theNumTimes := Card(TrackedTC);
  1298.                     for i := 1 to theNumTimes            # For each element of the TC
  1299.                     begin
  1300.                         if (TrackedTC[i])
  1301.                         begin
  1302.                             if(pTCID[i] = TrackedTC[i])    # Insure each item that defines match
  1303.                                 returnVal := 1;
  1304.                             else
  1305.                             begin
  1306.                                 returnVal := 0;
  1307.                                 i := theNumTimes;
  1308.                             end;
  1309.                         end;
  1310.                     end;
  1311.                     if (returnVal)
  1312.                         iterations := numTimes;            # If there was a match we're done
  1313.                 end;
  1314.             end;
  1315.         end;
  1316.         else if(pTCID = gTCTracking)
  1317.             returnVal := 1;
  1318.     end;
  1319.     return(returnVal);
  1320. end;
  1321.  
  1322.  
  1323. #########################################################################
  1324. #                CheckforSystemFailure()
  1325. #========================================================================
  1326. # Author:        KTA 
  1327. # Description:    Check for a system failure and calls Logs a testcase there was one.
  1328. # Parameters:    none
  1329. # Returns:        Nothing - But will call TCSEnd with the suitebailflag set, so
  1330. #                            the suite will be ended if there was a system crash.
  1331. # Examples:        CheckforSystemFailure();
  1332. # Assumptions:    none 
  1333. #                 Called by suiteEnd to insure that if a crash occurred after
  1334. #                  the last TCS that the data in Phoenix will represent what happened.
  1335. #========================================================================
  1336. # History:
  1337. # KTA     9/22/94        Created
  1338. # KTA     12/7/94        added try block
  1339. # ML    2/16/95        added returnval
  1340. #########################################################################
  1341. task CheckforSystemFailure()
  1342. begin
  1343.     returnval := not (_match([mouse]));
  1344.     theError := scriptError();
  1345.     if(theError)
  1346.     begin
  1347.         LogStr('The target crashed and CommandExceptions is not - ON');
  1348.         DefaultCrashHandler(theError, {1});
  1349.     end;
  1350.     return (returnval);
  1351. end;
  1352.  
  1353. #########################################################################
  1354. #                            ExitVU()
  1355. #========================================================================
  1356. # Author:        KTA
  1357. # Description:    This task makes the built in VU task Exit.  The purpose
  1358. #                of defining this as a task is so we can use a task 
  1359. #                reference to this task- gExitVu.  This way we can default 
  1360. #                our Exception Handling task to call the task reference gExitVU 
  1361. #                and thus exit. If others do not want to exit they can redefine 
  1362. #                the task reference to what ever task they prefer.
  1363. # Parameters:    None
  1364. # Returns:        Nothing
  1365. # Examples:        ExitVU(); or to use the task reference  - Call(global gExitVU);
  1366. # Assumptions:    Note: gExitVU is defined in Globals.lib.  If you want to 
  1367. #                override this task reference please do not modify Globals.Lib,
  1368. #                override the it by redefining it in Custom.Lib.
  1369. #########################################################################
  1370. #========================================================================
  1371. # History:
  1372. #    ML    2/3/94    Throw instead of exit
  1373. #########################################################################
  1374. TASK ExitVU()
  1375. begin
  1376.     throw "Thrown from ExitVU";
  1377. end;